perm filename PARRYR[4,KMC]1 blob
sn#006465 filedate 1972-10-25 generic text, type T, neo UTF8
00100 BEGIN
00200
00300 % ##### PARANOID MODEL ##### %
00400
00500
00600 NEW POINTERS, DELNO, LASTSTMT, DELFLAG, FLARE, FLAG, FLARELIST, REMARK,
00700 WEIGHT, DELAY, NREF, QWORD, GLOBX, GLOBY, TERMIN, RESTSENT, ANGER, FEAR, MISTRUST, ANGER0, FEAR0,
00800 MISTRUST0, TRACEV, DLIM, SUPPRESS, SENSITIVELIST, DELNLIST, DELVLIST, DELALIST, LIVEFLARES,
00900 LASTTOP, DEADFLARES, X, REST, SKEP, DELEND, AJUMP, FJUMP, TELL, NLIST, TVAL, SACTS, WEAK, INTERPERS,
01000 EOF, MESSAGE, ENDE, TALK, SAVE_FILE;
01100
01200 SPECIAL POINTERS, DELNO, LASTSTMT, DELFLAG, FLARE,
01300 SENSITIVELIST, FLAG, FLARELIST, WEIGHT, DELAY, NREF, QWORD, GLOBX, GLOBY,
01400 TERMIN, RESTSENT, ANGER, FEAR, MISTRUST, ANGER0, FEAR0, MISTRUST0, SUPPRESS,
01500 TRACEV, X, DLIM, DELNLIST, DELVLIST, DELALIST, LIVEFLARES, DEADFLARES, DELEND, SKEP, REST,
01600 LASTTOP, AJUMP, FJUMP, TELL, NLIST, TVAL, SACTS, WEAK, INTERPERS,
01700 EOF, MESSAGE, ENDE, TALK, SAVE_FILE, FILE1, FILE2, REMARK, CHAR;
01710 %ALOOCATIONS FOR RECONSTRUCTING PARRY
01720 R LISP 39
01730 FULL WORDS=3300
01740 BINARY PROGRAM SPACE=12000 %
01800
01900
02000 % ***** MAIN FUNCTIONS ***** %
02100
02200
02300 %
02400 INITIALIZE %
02500
02600 EXPR INITIALIZE ();
02700 BEGIN
02800 NEW VALUE,I, CONCEPT, WORD, SL, FL, DN, DV, AN, AV, ANV, AL, QL, RL, WTS, WT;
02900 SPECIAL VALUE, CONCEPT, WORD, SL, FL, DN, DV, AN, AV, ANV, AL, QL, RL, WTS, WT;
03000
03010 INITFN 'RESTART;
03100 IF ¬GET('SEND_MAIL,'SUBR) THEN % MAKE SURE THE DATA HAS BEEN READ IN. %
03200 BEGIN
03300 EVAL '(INC (INPUT (4 KMC) RDATA) NIL);
03400 WHILE NOT ATOM X ← ERRSET(READ(),T) DO EVAL CAR X;
03500 INC(NIL,T);
03600 END;
03700
03800 NLIST←GET ('NEGS, 'IND); % NEGATORS %
03900 SACTS←GET ('SACTS, 'IND); % META-ACTS, E.G. 'THINK' %
04000 I←0; % INDEX INTO SET OF REPLIES %
04100 DELNO←0; % CURRENT DELUSION-NUMBER %
04200 FLARE←'INIT; % FLARE=CURRENT FLARE TOPIC;
04300 'INIT = NONE %
04400 LIVEFLARES←GET ('FLARELIST, 'SETS); % FLARES NOT YET DISCUSSED %
04500 SENSITIVELIST←GET ('SENSITIVELIST, 'SETS); % SENSITIVE TOPICS %
04600 DELNLIST←GET ('DELWDS, 'NOUNS); % DELUSION TOPICS %
04700 DELVLIST←GET ('DELWDS, 'VERBS);
04800 DELALIST←GET ('DELWDS, 'AMBIG); % DELUSION TOPICS ABOVE A CERTAIN THRESHOLD OF MISTRUST %
04900
05000 % DLIM IS THE NUMBER OF "MORE GENERAL" DELUSIONS
05100 CURRENTLY IN THE PROGRAM %
05200
05300 DLIM←6;
05400
05500 % LASTTOP = LAST MAIN SELF-TOPIC DISCUSSED AND NOT LEFT;
05600 QWORD = PRESENT OR MOST RECENT KEYWORD TOPIC %
05700
05800 LASTTOP←QWORD←'INTROTOP;
05900 TERPRI NIL;
06000 PRINTSTR ("END INPUT PARAMETERS WITH CARRIAGE RETURN OR ALTMODE");
06100 TERPRI NIL;
06200 PRINTSTR ("SUPPRESS NON VERBAL FEATURE? [Y,N]");
06300 SUPPRESS←IF READ () = 'Y THEN T ELSE NIL;
06400 TERPRI NIL;
06500 PRINTSTR ("VERSION [WEAK, STRONG]");
06600 IF READ () EQ 'WEAK THEN
06700 BEGIN
06800 WEAK←T;
06900 ANGER←ANGER0←FEAR←FEAR0←MISTRUST←MISTRUST0←0;
07000 END
07100 ELSE
07200 BEGIN
07300 TERPRI NIL;
07400 PRINTSTR ("ANGER [LOW, MILD]");
07500 ANGER←(ANGER0←IF READ () = 'LOW THEN 0 ELSE 10);
07600 TERPRI NIL;
07700 PRINTSTR ("FEAR [LOW, MILD]");
07800 FEAR←(FEAR0←IF READ () = 'LOW THEN 0 ELSE 10);
07900 TERPRI NIL;
08000 PRINTSTR ("MISTRUST [MILD, HIGH]");
08100 MISTRUST←(MISTRUST0←IF READ () EQ 'MILD THEN 0 ELSE 15);
08200 END;
08300 TERPRI NIL;
08400 PRINTSTR ("TRACE VARIABLES? [Y,N]");
08500 IF READ () = 'Y THEN TRACEV←T;
08600
08700 EOF←PERCENT;
08800 PRINTSTR TERPRI "ARE TWO TELETYPES BEING USED? (Y,N)";
08900 IF READ () EQ 'Y THEN
09000 BEGIN
09100 TALK←T;
09200 PRINTSTR TERPRI "WHAT DISK FILE DO YOU WANT THIS INTERVIEW SAVED ON? (5 LETTERS ONLY)";
09300 FILE1 ← READ();
09400 FILE2 ← AT(SUBSTR(FILE1,1,5) CAT "A"); % OUTPUT ALTERNATES BETWEEN THESE TWO. %
09500 OUT(FILE1, NIL, T); % INITIALIZATION %
09600 END
09610 ELSE
09615 BEGIN
09620 PRINTSTR "DO YOU WANT THIS INTERVIEW SAVED ON A FILE?(Y,N)";
09625 IF READ () EQ 'Y THEN
09630 BEGIN
09635 SAVE_FILE ← T;
09640 PRINTSTR TERPRI "WHAT FILE DO YOU WANT THIS INTERVIEW SAVED ON?(5 LETTERS ONLY)";
09645 FILE1 ← READ();
09650 FILE2 ← AT(SUBSTR(FILE1,1,5) CAT "A");
09655 OUT(FILE1, NIL, T);
09660 END;
09670 END;
09700
09800 END;
09900
10000
10100 %
10200 ANGERMODE PROVIDES RESPONSES FOR HIGH ANGER LEVEL %
10300
10400 EXPR ANGERMODE ();
10500 IF ANGER GREATERP 17.5 THEN PROG2 (TERPRI NIL, SAY (CHOOSE ('ANGER)))
10600 ELSE PROG2 (TERPRI NIL, SAY (CHOOSE ('HOSTILEREPLIES)));
10700
10800 %
10900 CHECKFLARE SCANS THE INPUT SENTENCE FOR THE FLARE WORD WHICH HAS THE
11000 HIGHEST WEIGHT %
11100
11200 EXPR CHECKFLARE (INP, FLARELIST);
11300 BEGIN
11400 NEW NFLARE, WORD, FSET, WT, RESULT;
11500
11600 % DISTINGUISH FLARES FOUND WITHIN THE STATEMENT (NFLARE)
11700 FROM MOST RECENT FLARE (FLARE) %
11800
11900 NFLARE←'INIT; % GET ('INIT, 'WT) = 0 %
12000
12100 % SCAN INPUT FOR FLARES AND CHECK WHETHER WEIGHT IS
12200 GREATER THAN ANY PRECEDING FLARES IN INPUT %
12300
12400 FOR WORD IN INP DO
12500 IF (FSET←GET (WORD, 'SET)) MEMBER (FLARELIST) THEN
12600 IF (WT←GET (FSET, 'WT)) GREATERP GET (GET (NFLARE, 'SET), 'WT) THEN
12700 PROG2 (NFLARE←WORD, RESULT←T);
12800 IF RESULT THEN
12900
13000 % IF FLARE ALREADY BEING DISCUSSED, DISREGARD ANY
13100 VERY WEAK NEW FLARE %
13200
13300 IF NOT (FLARE = 'INIT) AND NOT ((WT←GET (GET (NFLARE, 'SET), 'WT)) GREATERP 1) THEN
13400 RESULT←NIL
13500 ELSE
13600 BEGIN
13700 FLARE←NFLARE;
13800 WEIGHT←WT; % USED IN COMPUTING RISE IN FEAR %
13900 END;
14000
14100 RETURN (RESULT);
14200
14300 END;
14400
14500 %
14600 DELREF SCANS THE INPUT SENTENCE FOR THE FIRST DIRECT REFERENCE TO 'SELF'S
14700 DELUSIONAL COMPLEX AND RETURNS A FEARFUL REACTION. IF NO SUCH REFERENCE
14800 IS FOUND, NIL IS RETURNED. %
14900
15000 EXPR DELREF (INP);
15100 BEGIN
15200 NEW WORD, FOUND;
15300 FOUND←DELCHECK (INP);
15400
15500 IF FOUND THEN
15600 BEGIN
15700 IF DELFLAG THEN
15800
15900 % IF DELUSIONS ALREADY BEING DISCUSSED, THEN
16000 DISTINGUISH BETWEEN "STRONG" AND "AMBIGUOUS" DELUSIONAL TOPICS
16100 IN COMPUTING RISE IN FEAR %
16200
16300 IF GET (CAR (FOUND), 'STRONG) THEN FJUMP←0.4
16400 ELSE FJUMP←0.2
16500 ELSE
16600 BEGIN
16700 FJUMP←0.5;
16800
16900 % 'MAFIA' TOPIC NO LONGEV INDUCES FEARFUL REACTION,
17000 SINCE DELUSION DISCUSSION HAS ALREADY BEEN EVOKED %
17100
17200 DELNLIST←DELETE ('MAFIA, DELNLIST);
17300
17400 % MODIFY FLARE STRUCTURES TO NOTE THAT 'MAFIA' TOPIC
17500 HAS ALREADY BEEN BROUGHT UP %
17600
17700 FLMOD ('MAFIASET);
17800 END;
17900
18000 % SET (OR KEEP) DELUSION FLAG = T UNLESS 'SELF HAS
18100 FINISHED DISCUSSION DELUSIONS %
18200
18300 IF NOT DELEND THEN DELFLAG←T;
18400
18500 % RESET SO THAT FLARES OF LOWER PRIORITY THAN THOSE WHICH
18600 MAY HAVE BEEN PREVIOUSLY MENTIONED ARE RECOGNIZED %
18700
18800 FLARE←'INIT;
18900 SAY (DELSTMT ());
19000
19100 % FORGET ABOUT RECENTLY DISCUSSED SELF-TOPICS %
19200
19300 LASTTOP←QWORD←'INTROTOP;
19400 END
19500 ELSE
19600 IF ('MAFIA % I.E. AS ALREADY USED DEL WD %
19700 MEMBER INP) THEN
19800
19900 % IF 'OTHER WANTS TO TALK ABOUT 'MAFIA' AFTER 'SELF HAS
20000 FINISHED DISCUSSING DELUSIONS, REJECT TOPIC %
20100
20200 IF DELEND THEN SAY (FOUND←CHOOSE ('MAFIASET))
20300 ELSE SAY (FOUND←DELSTMT ());
20400 RETURN (FOUND);
20500 END;
20600
20700 %
20800 DELSTMT CAUSES THE "NEXT" DELUSION TO BE EXPRESSED %
20900
21000 EXPR DELSTMT ();
21100 BEGIN
21200 NEW STMT; SPECIAL STMT;
21300
21400 % IN WEAK VEVSION, TALK ABOUT RACKETS RATHER THAN MAFIA %
21500
21600 IF WEAK THEN RETURN FLSTMT ('RACKETSET);
21700
21800 % IF 'SELF HAS ALREADY EXPRESSED ALL HIS DELUSIONS, HE REFERS TO
21900 PREVIOUSLY MENTIONED ONES UP TO 3 TIMES TOTAL %
22000
22100 IF DELNO = DLIM THEN DELNO←1
22200 ELSE DELNO←DELNO + 1;
22300 IF (FEAR GREATERP 12) OR (ANGER GREATERP 12) OR ((FEAR+ANGER+MISTRUST) GREATERP 20) THEN
22400 RETURN (PROG2 (DELFLAG←NIL, CHOOSE ('CHANGESUBJ)));
22500 DELFLAG←T;
22600 FLARE←'INIT;
22700
22800 % SELECT DELUSION %
22900
23000 STMT←CHOOSEDEL (DELNO);
23100
23200 % IF STMT CONTAINS DELUSIONAL FLARE, DELETE AS SUCH %
23300
23400 DELCHECK (STMT);
23500
23600
23700 % REMEMBER THE DELUSIONAL STATEMENT TO WHICH 'OTHER IS ABOUT TO RESPOND %
23800
23900 LASTSTMT←AT ("DEL" CAT DELNO);
24000 RETURN (STMT);
24100 END;
24200
24300 %
24400 DELTALK PRODUCES RESPONSE OF 'SELF IN CONTEXT OF EXPRESSION OF DELUSIONS %
24500
24600 EXPR DELTALK (STMT);
24700 IF NOT SKEP THEN
24800
24900 % NO LOCAL CONTEXT OF SKEPTICISM %
25000
25100 IF MEMBER1 (GET ('DISBELIEF, 'IND), STMT) THEN
25200
25300 % 'OTHER EXPRESSES DISBELIEF OF 'SELF'S DELUSIONS %
25400
25500 BEGIN
25600 AJUMP←0.3;
25700 FJUMP←0.1;
25800 SAY (CHOOSE ('BELIEVEREPLIES));
25900 SKEP←T;
26000 END
26100
26200 % CHECK FOR SPECIFIC QUESTION ABOUT DELUSIONS
26300 OR OTHER QUESTIONS %
26400
26500 ELSE SPECQUES (STMT) OR SAY (ANSWER (STMT))
26600 ELSE
26700 BEGIN
26800
26900 % IF FOLLOW-UP TO SKEPTICAL REMARK IS REASSURANCE,
27000 CONTINUE EXPRESSING DELUSIONS %
27100
27200 IF YES (STMT) THEN SAY (DELSTMT ())
27300 ELSE SAY (DISTRUST ());
27400 SKEP←NIL;
27500 END;
27600
27700 %
27800 FEARMODE PROVIDES FEARFUL REACTIONS TO STATEMENTS OF 'OTHER %
27900
28000 EXPR FEARMODE ();
28100 BEGIN
28200 TERPRI NIL;
28300 IF FEAR GREATERP 18.4 THEN SAY ('((EXITS)))
28400
28500 % DISTINGUISH BETWEEN QUESTIONS AND STATEMENTS OF 'OTHER %
28600
28700 ELSE QTHREAT (REMARK) OR SAY (CHOOSE ('AFRAID));
28800 END;
28900
29000 %
29100 FLAREREF HANDLES FLARE REFERENCES %
29200
29300 EXPR FLAREREF (INP);
29400 BEGIN
29500
29600 % CHECK FOR NEW FLARE AND RECORD AS "OLD" %
29700
29800 IF CHECKFLARE (INP, LIVEFLARES) THEN FLRECORD (GET (FLARE, 'SET));
29900
30000 % CHECK FOR OLD FLARE %
30100
30200 IF CHECKFLARE (INP, DEADFLARES) THEN
30400
30500 % RESPOND TO FLARE %
30600
30700 RETURN PROG2 (SAY (FLTALK (GET (FLARE, 'SET), 'Q CONS GET (FLARE, 'SET) CONS INP)), T);
30800 END;
30900
31000 %
31100 FLTALK %
31200
31300 EXPR FLTALK (FLSET, INP);
31400 IF FEAR GREATERP 14 OR ANGER GREATERP 14 THEN
31500 PROG2 (FLARE←'INIT, CHOOSE ('CHANGESUBJ))
31600
31700 % TRY TO ANSWER QUESTION ABOUT FLARE %
31800
31900 ELSE ANSWER (INP);
32000
32100 %
32200 IYOUME HANDLES INTERPERSONAL ATTITUDE STATEMENTS
32300
32400 THIS IS AN UNINTELLIGIBLE TEMPORARY ROUTINE WHICH REPRESENTS
32500 EXPERIMENTAL EFFORTS TO DISCOVER THE CASES WHICH MUST BE
32600 DISTINGUISHED IN DETERMINING THE MEANING OF THE INPUT %
32700
32800 EXPR IYOUME (INP);
32900 BEGIN
33000 NEW S, WD, SACT, ATTITUDE, AWORD, NWORDS, COUNT, REPLY;
33100 SPECIAL REPLY;
33200 TVAL←T;
33300 NWORDS←0;
33400
33500 % COLLECT RELEVANT ITEMS IN INPUT %
33600
33700 FOR WD IN INP DO
33800 IF WD EQ 'YOU OR WD EQ 'I OR WD EQ 'ME THEN PROG2 (S←WD CONS S, IF ATTITUDE THEN COUNT←NIL)
33900 ELSE
34000 IF WD MEMBER NLIST THEN TVAL←NOT TVAL
34100 ELSE
34200 IF WD MEMBER SACTS AND NOT SACT THEN
34300 PROG2 (SACT←WD CONS S, S←SUFLIST (S,2))
34400 ELSE
34500 IF NOT ATTITUDE AND ATTITUDE←GET (WD, 'ATTIT) THEN
34600 BEGIN
34700 S←(AWORD←WD) CONS S;
34800 NWORDS←0;
34900 COUNT←T;
35000 END
35100 ELSE
35200 IF COUNT THEN NWORDS←NWORDS + 1
35300 UNTIL LENGTH S = 3;
35400
35500 % TRANSFORM E.G. (I BELIEVE) (YOU) INTO (I BELIEVE YOU) %
35600
35700 IF SACT AND LENGTH S LESSP 2 THEN
35800 IF NOT ATTITUDE AND (ATTITUDE←GET (AWORD←CAR SACT, 'ATTIT)) THEN
35900 S←S @ SACT
36000 ELSE RETURN NIL;
36100
36200 % CHECK NO. OF WORDS BETWEEN ATTITUDE AND OBJECT %
36300
36400 IF NWORDS GREATERP 3 THEN RETURN NIL;
36500 IF GET (AWORD, 'NEG) THEN TVAL←NOT TVAL;
36600
36700 % CHECK FOR GENERAL ATTITUDE, E.G. (YOU ANGRY) %
36800
36900 IF LENGTH S LESSP 3 THEN
37000 IF S[2] EQ 'YOU AND S[1] EQ AWORD AND NOT GET (AWORD, 'FLIP) AND NOT GET (AWORD, 'RELN) THEN
37100 IF CAR INP EQ 'Q THEN PROG2 (INTERPERS←T, REPLY←ANSWER (INP))
37200 ELSE REPLY←CHOOSE ('SEEM)
37300 ELSE RETURN NIL
37400 ELSE
37500
37600 % CHECK FOR "YOU <ATTITUDE> ME" SITUATIONS %
37700
37800 IF S[3] EQ 'YOU AND S[2] EQ AWORD AND NOT GET (AWORD, 'FLIP) AND S[1] EQ 'ME OR
37900 S[3] EQ 'I AND GET (S[2], 'FLIP) AND S[1] EQ 'YOU OR
38000 S[3] EQ 'I AND S[2] EQ 'YOU AND S[1] EQ AWORD AND NOT GET (AWORD, 'FLIP) THEN
38100 IF NOT GET (AWORD, 'RELN) OR CAR S EQ 'ME THEN
38200 REPLY←CHOOSE (IF TVAL THEN ATTITUDE CONS 'YMREPLIES ELSE GET (ATTITUDE, 'OPP) CONS 'YMREPLIES)
38300 ELSE NIL
38400 ELSE
38500
38600 % CHECK FOR "I <ATTITUDE> YOU" SITUATIONS %
38700
38800 IF S[3] EQ 'I AND S[2] EQ AWORD AND NOT GET (AWORD, 'FLIP) AND S[1] EQ 'YOU OR
38900 S[3] EQ 'YOU AND GET (S[2], 'FLIP) AND S[1] EQ 'ME OR
39000 S[3] EQ 'YOU AND S[2] EQ 'ME AND S[1] EQ AWORD AND NOT GET (AWORD, 'FLIP) THEN
39100
39200 % TREAT REFERENCES TO SELF'S OPINION SIMILARLY TO AFFIRMATIVE
39300 STATEMENTS BY THE OTHER, AS FAR AS SELF'S ANSWER IS CONCERNED %
39400
39500 IF (CAR INP EQ 'Q OR SACT) AND CAR LAST SACT EQ 'YOU OR TVAL THEN
39600 REPLY←CHOOSE (ATTITUDE CONS 'IYREPLIES)
39700 ELSE
39800 BEGIN
39900 REPLY←CHOOSE (GET (ATTITUDE, 'OPP) CONS 'IYREPLIES);
40000 FJUMP←0.1;
40100 AJUMP←0.2;
40200 END;
40300 IF REPLY THEN RETURN PROG2 (SAY (REPLY), T);
40400 END;
40500
40600 %
40700 NORMAL HANDLES STATEMENT OF 'OTHER IN THE ABSENCE OF
40800 PROVOCATIVE INPUT %
40900
41000 EXPR NORMAL (STATEMENT);
41100 IF FEAR GREATERP 14 THEN FEARMODE ()
41200 ELSE
41300 IF ANGER GREATERP 14 THEN ANGERMODE ()
41400 ELSE
41500 IF DELFLAG THEN DELTALK (STATEMENT)
41600 ELSE
41700 PROMPT (STATEMENT);
41800
41900 %
42000 PERSREL %
42100
42200 EXPR PERSREL (INP);
42300 IYOUME (INP) OR APOLOG (INP) OR THREAT (INP);
42400
42500 %
42600 SELFREF SCANS THE INPUT SENTENCE FOR DIRECT OR INDIRECT REFERENCE TO THE SENSITIVE
42700 AREAS OF 'SELF AND CALLS FOR THE APPROPRIATE REPLY. IF NO SELF-REFERENCE
42800 IS PERCEIVED, NIL IS RETURNED. %
42900
43000 EXPR SELFREF (INP);
43100 BEGIN
43200 NEW YOU, NEG, FOUND, ADJ, CONCEPT, WORD;
43300
43400 % CHECK FOR DIRECT REFERENCE TO 'SELF %
43500
43600 IF ('YOU MEMBER INP) OR ('YOUR MEMBER INP) OR ('YOU?'RE MEMBER INP) THEN YOU←T;
43700
43800 % CHECK FOR EXPLICIT NEGATORS %
43900
44000 IF MEMBER1 (NLIST, INP) THEN NEG←T;
44100
44200 % CHECK FOR GENERAL INSULTS OR COMPLIMENTS %
44300
44400 FOR WORD IN INP DO
44500
44600 % CHECK 'YOU-NEGATION-INSULT' COMBINATIONS %
44700
44800 FOUND←IF WORD MEMBER GET ('INSULT, 'IND) THEN
44900 IF YOU THEN
45000 IF NOT NEG THEN PROG2 (AJUMP←0.8, CHOOSE ('ANGER))
45100 ELSE
45200 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.2, CHOOSE ('DISTANCE))
45300 ELSE PROG2 (AJUMP←0.3, CHOOSE ('PERS))
45400 ELSE
45500
45600 % CHECK 'YOU-NEGATION-COMPLIMENT' COMBINATIONS %
45700
45800 IF WORD MEMBER GET ('COMPL, 'IND) THEN
45900 IF YOU THEN
46000 IF NOT NEG THEN
46100 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.2,
46200 CHOOSE ('DISTANCE))
46300 ELSE
46400 PROG2 (AJUMP←0.7, CHOOSE ('HOSTILEREPLIES))
46500 ELSE PROG2 (AJUMP←0.5, CHOOSE ('SENSREPLIES) @ (WORD CONS '(??)))
46600 UNTIL FOUND;
46700
46800 IF FOUND THEN RETURN (PROG2 (SAY (FOUND), T));
46900
47000 % CHECK FOR POSITIVE OR NEGATIVE REFERENCE TO 'SELF IN SENSITIVE AREA %
47100
47200 ADJ←ADJTYPE (INP); % DETERMINE PRESENCE OF POS OR NEG ADJECTIVE %
47300 FOR WORD IN INP DO
47400
47500 % 'SPECIAL DENOTES PERSONAL SENSITIVE AREA, E.G. APPEARANCE %
47600
47700 IF (CONCEPT←GET (WORD, 'SET)) MEMBER SENSITIVELIST THEN
47800 FOUND←IF (NOT GET (CONCEPT, 'SPECIAL)) AND (CAR (INP) EQ 'Q) AND YOU THEN
47900 PROG2 (AJUMP←0.2, ANSWER (INP))
49100 ELSE
49200 IF YOU AND (GET (ADJ, 'TYPE) EQ 'NEG) THEN
49300 IF NOT NEG THEN
49400 PROG2 (AJUMP←0.7, CHOOSE ('HOSTILEREPLIES))
49500 ELSE
49600 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.3, CHOOSE ('DISTANCE))
49700 ELSE
49800 IF YOU AND (GET (ADJ, 'TYPE) EQ 'POS) THEN
49900 IF NOT NEG THEN
50000 PROG2 (IF MISTRUST GREATERP 9 THEN AJUMP←0.3,
50100 CHOOSE ('DISTANCE))
50200 ELSE
50300 PROG2 (AJUMP←0.7, CHOOSE ('HOSTILEREPLIES))
50400 ELSE
50500 IF YOU AND (GET (CONCEPT, 'SPECIAL) OR GET (ADJ, 'TYPE)) THEN
50600 BEGIN
50650 AJUMP←0.5;
50675 CONCEPT←<CONCEPT>;
50687 RETURN (CHOOSE ('DEFENSREPLIES) @ CONCEPT);
50693 END
50700 ELSE
50800 IF GET (ADJ,'TYPE) THEN
50900 PROG2 (AJUMP←0.5, SELFREFREPLY (ADJ, WORD))
51000 ELSE
51100 IF GET (CONCEPT, 'SPECIAL) THEN
51200 PROG2 (AJUMP←0.4, CHOOSE ('PERS))
51300 ELSE
51400 BEGIN
51450 AJUMP←0.2;
51475 CONCEPT← <CONCEPT>;
51487 RETURN (CHOOSE ('GUARD) @ CONCEPT);
51493 END
51500 ELSE NIL
51600 UNTIL FOUND;
51700 IF FOUND THEN RETURN (PROG2 (SAY (FOUND), T));
51800 END;
51900
52000 % 'TALK' ROUTINES FOR TWO TELETYPES %
52100
52200
52300 FEXPR OUT (L); % L = (DESTINATION FUNCTION OPEN CLOSE) %
52400 IF L[1] EQ 'DOC THEN SEND_MAIL('DOCJOB, L[2]) ELSE
52500 IF L[1] EQ 'OWN THEN EVAL L[2]
52600 ELSE BEGIN
52700 IF LENGTH L ≥ 3 & L[3] THEN EVAL <'OUTPUT, 'DSK:, EVAL L[1]>;
52800 OUTC(T, NIL);
52900 EVAL L[2];
53000 OUTC(NIL, IF LENGTH L = 4 THEN L[4] ELSE NIL);
53100 END;
53200
53300 FEXPR INP (L); % L = (SOURCE FUNCTION) %
53400 IF L[1] EQ 'DOC THEN SEND_MAIL('DOCJOB, <'SEND_MAIL, '(QUOTE HAR000), L[2]>) ALSO WAIT_FOR_MAIL(L[3])
53500 ELSE EVAL L[2];
53600
53700 EXPR READ_MESSAGE ();
53800 BEGIN NEW L;
53900 PRINTSTR "READY:";
54000 TERPRI TERPRI DO NIL UNTIL CAR(L ← READCH() CONS L) EQ ALTMODE & CADR L EQ ALTMODE;
54100 RETURN REVERSE CDDR L
54200 END;
54300
54400 EXPR PRINT_MESSAGE (MESSAGE); TERPRI TERPRI FOR NEW CH IN MESSAGE DO PRINC CH;
54500
54600 EXPR PRINT_ALL (FILE); % COPIES FILE "FILE" TO THE CURRENTLY OPEN OUTPUT FILE. %
54700 BEGIN NEW CH;
54800 EVAL <'INC, <'INPUT, FILE, 'DSK:, FILE>, NIL>;
54900 DO NIL UNTIL TYO TYI() EQ OCTAL 45 & (ATOM(CH ← ERRSET(READCH(),T)) | PRINC CAR CH & NIL);
55000 INC(NIL,T)
55100 END;
00100
00200 % ***** AUXILIARY FUNCTIONS ***** %
00300
00400
00500 %
00600 ADJTYPE RETURNS AND TRIES TO IDENTIFY ANY VALUE-TYPE MODIFIERS IN STATEMENT %
00700
00800 % TO BE REWRITTEN %
00900
01000 EXPR ADJTYPE (STMT);
01100 BEGIN
01200 NEW WORD, TYPE, FOUND;
01300 FOR WORD IN STMT DO
01400 FOR TYPE IN '(POS NEG AMBIG) DO
01500 IF WORD MEMBER GET ('ADJLIST, TYPE) THEN
01600 FOUND←PROG2 (PUTPROP (WORD, TYPE, 'TYPE), WORD)
01700 UNTIL FOUND
01800 UNTIL FOUND;
01900 RETURN (WORD);
02000 END;
02100
02200 %
02300 ANSVAR ALTERNATIVELY SELECTS ONE OF TWO VARIANTS OF AN ANSWER %
02400
02500 EXPR ANSVAR (KEYWD);
02600 BEGIN
02700 NEW A;
02710 IF NULL A←GET (KEYWD, 'A) THEN RETURN
02712 IF FLARE EQ 'INIT THEN CHOOSE ('EXHAUST)
02714 ELSE FLSTMT (GET (FLARE, 'SET))
02720 ELSE
02800 IF NOT ATOM CAR A THEN
02900
03000 % 'A' CONSISTS OF A LIST OF 2 ANSWERS: ((---)(---))
03100 RATHER THAN OF AN ANSWER: (---) %
03200
03300 RETURN CHOOSE (KEYWD CONS 'A)
03400 ELSE RETURN A;
03800 END;
03900
04000 %
04100 ANSWER HANDLES QUESTIONS OF 'OTHER:
04200 IF NO RECOGNIZED TOPIC ABOUT 'SELF IS BEING CONTINUED AND NO REFERENCE
04300 TO 'SELF IS DETECTED, THE QUESTION IS TREATED AS MISCELLANEOUS;
04400 OTHERWISE AN ANSWER TO THE QUESTION IS ATTEMPTED %
04500
04600 EXPR ANSWER (Q);
04700 BEGIN
04800 NEW ANS, WORD, CONCEPT;
04900
05000 SPECIAL ANS, QWORD;
05100
05200 % "INTERROGATIVE IMPERATIVES" ARE CONSIDERED AS QUESTIONS ABOUT 'SELF %
05300
05400 IF ('TELL MEMBER Q) THEN
05500 Q←('Q CONS 'YOU CONS Q)
05600 ELSE
05700
05800 % STATEMENTS THAT THE 'OTHER HAS A QUESTION ARE CONSIDERED AS QUESTIONS %
05900
06000 IF MEMBER1 (GET ('QUES, 'IND), Q) THEN
06100 Q←'Q CONS 'QUESTION CONS Q
06200 ;
06300
06400 % IF INPUT IS A QUESTION AND NO TOPIC IS CURRENTLY UNDER DISCUSSION
06500 AND INPUT REFERS TO SELF, EXPECT ONLY QUESTIONS RELATING
06600 TO A MAIN "SELF-TOPIC" %
06700
06800 IF CAR Q EQ 'Q AND QWORD EQ 'INTROTOP AND ('YOU MEMBER Q OR 'YOUR MEMBER Q) THEN
06900 ANS←ANSWER1 (Q, GET ('INTROTOP, 'Q))
07000 ELSE
07100
07200 % IF ALREADY ON SOME TOPIC, CHECK FIRST FOR NEW MAIN TOPIC,
07300 THEN FOR FOLLOW-UP TO LAST SUBTOPIC, THEN (UNLESS SUBTOPIC =
07400 MAIN TOPIC) FOR FOLLOW-UP TO LAST MAIN TOPIC %
07500
07600 IF QWORD NEQ 'INTROTOP THEN
07700 (IF MEMBER1 ('(YOU YOUR), Q) THEN ANS←ANSWER1 (Q, GET ('INTROTOP, 'Q))) OR (ANS←ANSWER2 (Q)) OR
07800 IF QWORD NEQ LASTTOP THEN ANS←PROG2 (QWORD←LASTTOP, ANSWER2 (Q))
07900 ;
08000 IF NOT ANS THEN
08100
08200 % NO QUESTIONS RECOGNIZED %
08300
08400 BEGIN
08500 ANS←IF CAR Q EQ 'Q THEN MISCQ (Q) ELSE MISCS (Q);
08600
08700 % REINITIALIZE TOPIC INDICATORS %
08800
08900 LASTTOP←QWORD←'INTROTOP;
09000 END;
09100 ASCAN (ANS, Q);
09200 RETURN (ANS);
09300 END;
09400 %
09500 ANSWER1 %
09600
09700 EXPR ANSWER1 (Q, TOPICS);
09800 BEGIN
09900 NEW CONCEPT, SPEC, ANS;
10000 SPECIAL ANS, QWORD;
10100 % TRY TO MATCH WORDS OF QUESTION WITH ONE OF THE SELF-TOPICS %
10200
10300 FOR CONCEPT IN TOPICS DO
10400 IF MEMBER1 (CONCEPT, Q) THEN
10500 BEGIN
10600
10700 % CHECK FOR SPECIFIC QUESTION ABOUT TOPIC
10800 MENTIONED IN THIS SENTENCE %
10900
11000 FOR SPEC IN GET (LASTTOP←CAR (CONCEPT), 'Q) DO
11100 IF MEMBER1 (SPEC, Q) THEN % QUESTION ABOUT MAIN TOPIC RECOGNIZED %
11200 ANS←ANSVAR (QWORD←CAR SPEC)
11300 UNTIL ANS;
11400
11500 IF NOT ANS THEN
11600
11700 % NO SPECIFIC QUESTION ABOUT THIS MAIN TOPIC RECOGNIZED %
11800
11900 BEGIN
12000
12100 % SAVE TOPIC KEY WORD %
12200
12300 QWORD←CAR (CONCEPT);
12400
12500 % GET ANSWER ASSCIATED WITH TOPIC KEY WORD %
12600
12700 ANS←ANSVAR (QWORD);
12800 END;
12900 END
13000 UNTIL ANS;
13100 RETURN (ANS);
13200 END;
13300 %
13400 ANSWER2 %
13500
13600 EXPR ANSWER2 (Q);
13700 BEGIN
13800 NEW CONCEPT, ANS;
13900 SPECIAL QWORD;
14000
14100 % CHECK FOR SPECIFIC QUESTION ABOUT TOPIC
14200 MENTIONED IN THE PRECEDING SENTENCE %
14300
14400 FOR CONCEPT IN GET (QWORD, 'Q) DO
14500 IF MEMBER1 (CONCEPT, Q) THEN
14600 ANS←ANSVAR (QWORD←CAR CONCEPT)
14700 UNTIL ANS;
14800 RETURN (ANS);
14900 END;
15000
15100 %
15200 APOLOG RESPONDS DIFFERENTIALLY TO APOLOGIES ACCORDING TO MISTRUST LEVEL %
15300
15400 EXPR APOLOG (STMT);
15500 IF MEMBER1 (GET ('APOL, 'IND), STMT) THEN
15600 BEGIN
15700 IF MISTRUST GREATERP 9 THEN
15800 AJUMP←0.2
15900 ELSE ANGER ← ANGER-1;
16000 SAY (CHOOSE ('ACCUSE));
16100 RETURN (T);
16200 END;
16300
16400 %
16500 ASCAN SCANS 'SELF'S ANSWER FOR MENTION OF FLARE OR MAFIA %
16600
16700 EXPR ASCAN (ANS, Q);
16800 BEGIN
16900 IF CHECKFLARE (ANS, LIVEFLARES) THEN FLMOD (GET (FLARE, 'SET));
17000 IF 'MAFIA MEMBER ANS THEN
17100 BEGIN
17200 DELFLAG←T;
17300 FLARE←'INIT;
17400 END;
17500 END;
17600
17700 %
17800 BADINP %
17900
18000 EXPR BADINP (SENT);
18100 BEGIN
18200 TERPRI NIL;
18300 IF '?: ε SENT THEN
18400 RETURN (PROG2 (PRINTSTR (STRINGATE (SENT)), T));
18500 END;
18600
18700 %
18800 BLANKSKIP RETURNS THAT PART OF SENTENCE FOLLOWING ANY SEQUENCE OF LEADING BLANKS,
18900 CARRIAGE RETURNS OR LINE FEEDS %
19000
19100 EXPR BLANKSKIP (SENT);
19200 IF NULL SENT THEN NIL
19300 ELSE
19400 IF CAR SENT EQ BLANK OR CAR SENT EQ CR OR CAR SENT EQ LF THEN BLANKSKIP (CDR SENT)
19500 ELSE SENT;
19600
19700 %
19800 CHOOSE SELECTS THE NEXT REPLY FROM THE RELEVANT GROUP %
19900
20200 EXPR CHOOSE (REPLIES);
20300 BEGIN
20400 NEW REPLY, RESPONSES, IND;
20410 SPECIAL ENDE;
20500 IF NOT ATOM REPLIES THEN
20600 BEGIN
20700 IND←CDR REPLIES;
20800 REPLIES←CAR REPLIES;
20900 END
21000 ELSE IND←'IND;
21100 IF NULL RESPONSES←GET (REPLIES, IND) THEN
21200 RETURN
21300 IF REPLIES EQ 'EXHAUST THEN PROG2 (ENDE←T, '((FED UP)) )
21400 ELSE PROG2(CONCEPT←NIL, CHOOSE ('EXHAUST));
21500 REPLY←CAR RESPONSES;
22500 PUTPROP (REPLIES, CDR RESPONSES, IND);
22600 RETURN REPLY;
22700 END;
22800
22900 %
23000 CHOOSEDEL CHOOSES A DELUSIONAL RESPONSE ACCORDING TO "TYPE", WHICH INDICATES
23100 WHETHER THE NEXT GENERAL DELUSION IS TO BE SELECTED (TYPE=NUMBER)
23200 OR A CERTAIN TYPE OF QUESTION IS TO BE ANSWERED %
23300
23400 EXPR CHOOSEDEL (TYPE);
23500 BEGIN
23600 NEW DEL, REPLY, FREQ, OLDF;
23700 IF NUMBERP (TYPE) THEN
23800 DEL←AT ('DEL CAT TYPE)
23900 ELSE DEL←TYPE;
24000 REPLY←IF (OLDF←GET (DEL, 'FREQ)) LESSP 3 THEN
24100 BEGIN
24200 NEW DELN;
24300
24400 % RAISE FREQUENCY %
24500
24600 PUTPROP (DEL, FREQ←OLDF+1, 'FREQ);
24700 DELN←CAR (SUFLIST (GET ('DELUSIONS, DEL), FREQ-1));
24800 RETURN (IF (TYPE = 1) OR (TYPE = 4) THEN % FOR VARIATION ONLY %
24900 GET ('PREFACE, GET (DEL, 'FREQ)) @ DELN
25000 ELSE DELN);
25100 END
25200 ELSE
25300 % 'SELF HAS MENTIONED THIS DELUSION 3 TIMES %
25400 BEGIN
25500 DELFLAG←NIL;
25600 DELEND←T; % DELUSION-END FLAG %
25700 RETURN ('(LET?'S TALK ABOUT SOMETHING ELSE?- I?'VE GIVEN
25800 YOU SOME IDEA OF WHAT?'S GOING ON));
25900 END;
26000 RETURN (REPLY);
26100 END;
26200
26300 %
26400 DELCHECK RETURNS ANY NEW DELUSION-EXPRESSIONS FOUND IN INPUT AND DELETES AS SUCH %
26500
26600 EXPR DELCHECK (INP);
26700 BEGIN
26800 NEW WORDS;
26900
27000 % CHECK FOR STRONG DELUSION-NOUNS AND -VERBS
27100 (AT PRESENT THE NOUN-VERB DISTINCTION IS NOT UTILIZED %
27200
27300 IF WORDS←MEMBER1 (DELNLIST, INP) THEN
27400 DELNLIST←DELETE (WORDS, DELNLIST)
27500 ELSE
27600 IF WORDS←MEMBER1 (DELVLIST, INP) THEN
27700 DELVLIST←DELETE (WORDS, DELVLIST)
27800 ELSE
27900
28000 % CHECK FOR AMBIGUOUS DELUSION WORDS AT HIGH MISTRUST LEVEL %
28100
28200 IF MISTRUST GREATERP 10 AND WORDS←MEMBER1 (DELALIST, INP) THEN
28300 DELALIST←DELETE (WORDS, DELALIST)
28400 ;
28500 RETURN (IF WORDS AND ATOM WORDS THEN WORDS CONS NIL ELSE WORDS);
28600 END;
28700
28800
28900 %
29000 DELETE DELETES WORD WD FROM LIST L %
29100
29200 EXPR DELETE (WD, L);
29300 IF NULL L THEN NIL
29400 ELSE
29500 IF WD EQ CAR (L) THEN CDR (L)
29600 ELSE CAR (L) CONS DELETE (WD, CDR (L));
29700
29800 %
29900 DISTRUST HANDLES FOLLOW-UPS TO LOCAL SITUATIONS OF DISTRUST %
30000
30100 EXPR DISTRUST ();
30200 IF (FEAR GREATERP 10) OR (ANGER GREATERP 10) OR
30300 ((FEAR + ANGER) GREATERP 14) THEN
30400 CHOOSE ('TURNOFF)
30500 ELSE CHOOSE ('ALOOF);
30600
30700 %
30800 FIXPTRS TRANSFERS HIERARCHICAL POINTERS TO NEW FLARE
30900 TO NEXT HIGHER FLARE IN PATH %
31000
31100 EXPR FIXPTRS (FLSET);
31200 BEGIN
31300 NEW CONCEPT;
31400 FOR CONCEPT IN LIVEFLARES @ DEADFLARES DO
31500 IF GET (CONCEPT, 'NEXT) EQ FLSET THEN
31600 PUTPROP (CONCEPT, GET (FLSET, 'NEXT), 'NEXT);
31700 END;
31800
31900 %
32000 FLRECORD NOTES MENTION OF FLARE AND RAISES FEAR %
32100
32200 EXPR FLRECORD (FLSET);
32300 BEGIN
32400 FLMOD (FLSET);
32500 FJUMP←WEIGHT/40.0;
32600
32700 % REINITIALIZE SELF-TOPIC INDICATORS %
32800
32900 LASTTOP←QWORD←'INTROTOP;
33000 END;
33100
33200 %
33300 FLMOD MOVES NEW FLARE FROM "LIVELIST" TO "DEADLIST" AND
33400 ADJUSTS FLARE POINTER HIERARCHY %
33500
33600 EXPR FLMOD (FLSET);
33700 BEGIN
33800 LIVEFLARES←DELETE (FLSET, LIVEFLARES);
33900 DEADFLARES←(FLSET CONS DEADFLARES);
34000 FIXPTRS (FLSET);
34100 END;
34200
34300 %
34400 FLARELEAD DECIDES WHAT TYPE OF "SUSPICIOUSNESS" REPLY IS SUITED
34500 TO INTRODUCE THE FLARE CONCEPT %
34600
34700 EXPR FLARELEAD (FLSET);
34800 BEGIN
34900 IF GET (FLSET, 'TYPE) EQ 'INSTITUTION THEN
35000 RETURN (CHOOSE ('NEXTFL) @ '(THE) @
35100 <CAR (GET (FLSET, 'WORDS))>)
35200 ELSE
35300 RETURN (CHOOSE ('NEXTFL) @
35400
35500 % DO NOT TREAT SINGULARS AS A GENERIC TOPIC %
35600
35700 (IF CAR (LAST (EXPLODE (FLARE))) EQ 'S THEN <FLARE>
35800 ELSE <CAR (GET (FLSET, 'WORDS))>)
35900 );
36000 END;
36100
36200 %
36300 FLSTMT PROVIDES NEXT STATEMENT ABOUT FLARE %
36400
36500 EXPR FLSTMT (FSET);
36600
36700 % IF REACH 'MAFIASET THRU FLARE HIERARCHY, ENTER DELUSIONAL MODE %
36800
36900 IF (FSET EQ 'MAFIASET) AND NOT DELEND THEN
37000 PROG2 (DELFLAG←T, DELSTMT ())
37100 ELSE
37200 IF (NREF←GET (FSET, 'NREF)) LESSP 2 THEN
37300 BEGIN
37400 PUTPROP (FSET, NREF←(NREF+1), 'NREF);
37500
37600 % MAKE NEXT STATEMENT ABOUT CURRENT FLARE TOPIC %
37700
37800 RETURN (CAR (SUFLIST (GET (FSET, 'STMTS), NREF-1)));
37900 END
38000
38100 % GO TO NEXT FLARE TOPIC %
38200
38300 ELSE LEADON (GET (FSET, 'NEXT))
38400 ;
38500
38600 %
38700 JOIN INSERTS HYPHENS BETWEEN WORDS OF ONE CONCEPT TO
38800 MAKE ONE ATOM %
38900
39000 EXPR JOIN (!L); READLIST(EXPLODEC(CAR(!L)) @ JOIN1(CDR(!L)));
39100
39200 EXPR JOIN1 (!L); IF NULL !L THEN NIL ELSE DASH CONS EXPLODEC(CAR(!L)) @ JOIN1(CDR(!L));
39300
39400 %
39500 LEADON %
39600
39700 EXPR LEADON (NEWSET);
39800 BEGIN
39900 IF NEWSET NEQ 'MAFIASET THEN
40000
40100 % RECORD NEW FLARE %
40200
40300 BEGIN
40400 FLMOD (NEWSET);
40500 FLARE←CAR (GET (NEWSET, 'WORDS));
40600 END
40700 ELSE
40800 IF DELEND THEN
40900
41000 % ARRIVE AT 'MAFIASET BUT THROUGH WITH DELUSIONS %
41100
41200 RETURN (PROG2 (FLARE←'INIT, CHOOSE ('FEELER)))
41300 ELSE
41400 IF WEAK OR (FEAR GREATERP 12) OR (ANGER GREATERP 12) OR
41500 ((FEAR + ANGER + MISTRUST) GREATERP 20) THEN
41600
41700 % ARRIVED AT 'MAFIASET BUT DOES NOT HAVE DELUSIONS ABOUT
41800 MAFIA OR IS UNWILLING TO DISCUSS THEM %
41900
42000 RETURN (CHOOSE ('CHANGESUBJ))
42100 ELSE
42200 BEGIN
42300 DELETE ('MAFIA, DELNLIST);
42400 DELFLAG←T;
42500 FLARE←'INIT;
42600 END;
42700
42800 % RESPOND WITH NEW FLARE %
42900
43000 RETURN (FLARELEAD (NEWSET));
43100 END;
43200
43300 %
43400 MEMBER1 CHECKS WHETHER ATOMS OR GROUPS OF WORDS IN WLIST ARE PRESENT IN INPUT %
43500
43600 EXPR MEMBER1 (WLIST, SPECIAL INP);
43700 BEGIN
43800 NEW FOUND, GROUP;
43900 FOR GROUP IN WLIST DO
44000 FOUND←IF ATOM (GROUP) THEN GROUP MEMBER INP
44100 ELSE
44200 EVAL ('AND CONS MAPCAR (FUNCTION (LAMBDA (X); X MEMBER INP), GROUP))
44300 UNTIL FOUND;
44400 IF FOUND THEN RETURN GROUP;
44500 END;
44600
44700 %
44800 MISCQ TRIES TO DETECT AND ANSWER CERTAIN RECOGNIZABLE QUESTIONS.
44900 IF IT FAILS, IT TRIES TO DISCERN WHETHER THE QUESTION CONTAINS
45000 INTERROGATIVE WORDS REQUIRING A SPECIFIC ANSWER, OR WHETHER IT
45100 REQUIRES A GENERAL YES- OR NO-TYPE ANSWER,
45200 AND CALLS FOR AN APPROPRIATE REPLY %
45300
45400 EXPR MISCQ (Q);
45500 BEGIN
45600 NEW QWORD, ANS, CONCEPT;
45700 IF SUFLIST (Q, LENGTH Q - 3) = '(HOW ARE YOU) THEN ANS←'(ALL RIGHT)
45800 ELSE
45900
46000 % INTERPERSONAL ATTITUDE MAY HAVE BEEN SET IN IYOUME IN CONTEXT OF 'YOU <ATTITUDE>' %
46100
46200 IF INTERPERS THEN RETURN PROG2 (INTERPERS←NIL,
46300 IF MEMBER1 (GET ('QLIST, 'IND), Q) THEN CHOOSE ('WFEEL)
46400 ELSE CHOOSE ('QFEEL) )
46500 ELSE
46600
46700 % CHECK FOR QUESTION ABOUT EXTERNAL WORLD %
46800
46900 IF NOT (ANS←OBJQ (Q)) THEN
47000 IF 'HOW MEMBER Q THEN
47100
47200 % UNIDENTIFIABLE "HOW-TYPE" QUESTION %
47300
47400 FOR CONCEPT IN '(MANY MUCH LONG OFTEN) DO
47500 IF CONCEPT MEMBER Q THEN ANS←CHOOSE (CONCEPT)
47600 UNTIL ANS;
47700 IF ANS THEN RETURN (ANS)
47800 ELSE
47900
48000 % IF QUESTION NOT RECOGNIZED, TRY TO ANSWER ACCORDING TO CONTEXT %
48100
48200 IF FLARE NEQ 'INIT THEN RETURN FLSTMT (GET (FLARE, 'SET))
48300 ELSE
48400 IF DELFLAG THEN RETURN DELSTMT ()
48500 ELSE
48600
48700 % WH- QUESTIONS %
48800
48900 IF 'WHY MEMBER Q THEN ANS←CHOOSE ('WHY)
49000 ELSE
49100 FOR QWORD IN GET ('QLIST, 'IND) DO
49200 (ANS← IF QWORD MEMBER Q THEN CHOOSE ('UNKNOWN))
49300 UNTIL ANS;
49400 IF ANS THEN RETURN (ANS)
49500 ELSE
49600
49700 % MISCELLANEOUS "TELL-" QUESTION %
49800
49900 IF ('TELL MEMBER Q) THEN RETURN '(I DON?'T KNOW ANYTHING ABOUT THAT)
50000 ELSE
50100
50200 % NO CLUES - ANSWER NONCOMMITTALLY %
50300
50400 RETURN (CHOOSE ('QREPLIES));
50500 END;
50600
50700 %
50800 MISCS TRIES TO DETECT AND ANSWER CERTAIN RECOGNIZABLE STATEMENTS,
50900 MAINLY IMPERATIVES AND EXPECTED EXPRESSIONS %
51000
51100 EXPR MISCS (S);
51200 IF ('JUMP MEMBER S) THEN '((EXITS))
51300 ELSE
51400 IF (CAR (S) EQ 'HI) OR (CAR (S) EQ 'HELLO) OR (CAR (S) EQ 'HOWDY) OR
51500 CADR S MEMBER '(MORNING AFTERNOON EVENING) THEN '(HELLO)
51600 ELSE
51700 IF (('AM MEMBER S) AND ('DOCTOR MEMBER S) OR ('DR MEMBER S)) OR
51800 (('MY MEMBER S) AND ('NAME MEMBER S)) THEN
51900 '(GLAD TO MEET YOU)
52000 ELSE
52100 IF (('ALREADY MEMBER S) OR ('BEFORE MEMBER S)) AND
52200 (('SAID MEMBER S) OR ('MENTIONED MEMBER S)) THEN
52300 '(I GUESS I DID)
52400 ELSE
52500
52600 % LOOK AT CONTEXT OF CONVERSATION %
52700
52800 IF FLARE NEQ 'INIT THEN FLSTMT (GET (FLARE, 'SET))
52900 ELSE
53000 IF DELFLAG THEN DELSTMT ()
53100
53200 % NONCOMMITTAL REPLY %
53300
53400 ELSE CHOOSE ('SREPLIES);
53500
53600 %
53700 MODIFVAR MODIFIES AFFECT VARIABLES AFTER EACH I-O PAIR %
53800
53900 EXPR MODIFVAR ();
54000 BEGIN
54100 RAISE ();
54200
54300 % ACCOUNT FOR NORMAL DROP IN EACH VARIABLE %
54400
54500 ANGER←IF ANGER GREATERP ANGER0 + 1 THEN ANGER - 1 ELSE ANGER0;
54600 IF DELFLAG THEN
54700
54800 % ADD 5 TO BASE VALUE OF FEAR IF DELUSIONS UNDER DISCUSSION %
54900
55000 FEAR←IF FEAR GREATERP FEAR0 + 5.1 THEN FEAR - 0.1 ELSE FEAR0 + 5
55100 ELSE
55200 IF FLARE NEQ 'INIT THEN
55300
55400 % ADD 3 TO BASE VALUE OF FEAR IF FLARES UNDER DISCUSSION %
55500
55600
55700 FEAR←IF FEAR GREATERP FEAR0 + 3.2 THEN FEAR - 0.2 ELSE FEAR0 + 3
55800 ELSE
55900 FEAR←IF FEAR GREATERP FEAR0 + 0.3 THEN FEAR - 0.3 ELSE FEAR0;
56000 MISTRUST←IF MISTRUST GREATERP MISTRUST0+0.05 THEN MISTRUST - 0.05 ELSE MISTRUST0;
56100 IF TRACEV THEN
56200
56300 % PRINT OUT VALUES OF VARIABLES %
56400
56500 BEGIN
56600 TERPRI NIL;
56700 PRINTSTR (" FEAR = " CAT FEAR);
56800 PRINTSTR (" ANGER = " CAT ANGER);
56900 PRINTSTR (" MISTRUST = " CAT MISTRUST);
57000 END;
57100 TERPRI NIL;
57200 END;
57300
57400 %
57500 NULLSKIP RETURNS THAT PART OF SENT FOLLOWYNG AN SEQUENCE OF
57600 BLANKS, CARRIAGE RETURNS, LINE FEEDS, COMMAS OR DASHES %
57700
57800 EXPR NULLSKIP (SENT);
57900 IF (CHAR←CAR SENT) EQ BLANK OR (CHAR EQ CR) OR (CHAR EQ LF) OR (CHAR EQ COMMA) OR (CHAR EQ DASH) THEN
58000 NULLSKIP (CDR SENT)
58100 ELSE SENT;
58200
58300 %
58400 OBJQ HANDLES "OBJECTIVE"-TYPE QUESTIONS
58500 (ABOUT LOCAL EXTERNAL WORLD) %
58600
58700 EXPR OBJQ (Q);
58800 BEGIN
58900 NEW PAIR, FOUND;
59000 IF (('WHAT MEMBER Q) OR ('WHO MEMBER Q) OR ('WHICH MEMBER Q)) AND
59100 FOR PAIR IN GET ('OBJDATA, 'IND) DO
59200 FOUND←IF <CAR (PAIR)> MEMBER1 Q THEN CADR (PAIR)
59300 UNTIL FOUND THEN
59400 RETURN (FOUND);
59500 END;
59600
59700 %
59800 PROMPT HANDLES "TELL-ABOUT-YOURSELF" QUESTIONS %
59900
60000 % TO BE REWRITTEN (KEN REWROTE THIS 11/4/71) %
60100
60200
60300 EXPR PROMPT (INP);
60400 IF MEMBER1 (GET ('DISCUSS, 'IND), INP) AND MEMBER1 (GET ('SELF, 'IND), INP) THEN
60500 BEGIN
60600 NEW ANS;
61100 INP←'TELL CONS INP;
61300 SAY (ANS←ANSWER1 (INP, GET ('INTROTOP, 'Q)));
61400 ASCAN (ANS, INP);
61500 END
61600 ELSE SAY (ANSWER (INP));
61700
61800 %
61900 QTHREAT RESPONDS SUSPICIOUSLY TO QUESTIONS AT HIGH FEAR LEVEL %
62000
62100 EXPR QTHREAT (STMT);
62200 IF CAR (STMT) EQ 'Q THEN PROG2 (SAY (CHOOSE ('THREATQ)), T)
62300 ;
62400
62500 %
62600 RAISE RAISES LEVEL OF RELEVANT AFFECT VARIABLES;
62700 REDUCE JUMP IF IN WEAK VERSION %
62800
62900 EXPR RAISE ();
63000 BEGIN
63100 IF FJUMP THEN
63200 BEGIN
63300 IF WEAK THEN FJUMP←0.3 * FJUMP;
63400 FEAR ← (FEAR + FJUMP * (20 - FEAR));
63500 MISTRUST ← (MISTRUST + (0.5 * FJUMP) * (20 - MISTRUST));
63600 MISTRUST0←MISTRUST0 + 0.1 * FJUMP * (20 - MISTRUST0);
63700 FJUMP←NIL;
63800 END;
63900 IF AJUMP THEN
64000 BEGIN
64100 IF WEAK THEN AJUMP←0.7 * AJUMP;
64200 ANGER ← (ANGER + AJUMP * (20 - ANGER));
64300 MISTRUST ← (MISTRUST + (0.5 * AJUMP) * (20 - MISTRUST));
64400 MISTRUST0←MISTRUST0 + 0.1 * AJUMP * (20 - MISTRUST0);
64500 AJUMP←NIL;
64600 END;
64700 END
64800 ;
64900
65000 %
65100 READSENT RETURNS SCANNED SENTENCE IN THE FORM OF A LIST OF WORDS %
65200
65300
65400 EXPR READSENT (SENT);
65500
65600 % SENT IS A LIST OF INPUT CHARACTERS %
65700
65800 BEGIN
65900 NEW CHAR;
66000 TERMIN←NIL;
66100
66200 % SKIP OVER LEADING CHARACTERS WHICH AREN'T LETTERS OR NUMBERS %
66300
66400 WHILE NOT (GET (CHAR←CAR SENT, 'LET) OR NUMBERP CHAR OR NULL SENT) DO SENT←CDR SENT;
66500 IF NULL SENT THEN TERMIN←'ILL
66600 ELSE RETURN READSENT1 (SCANWD (BLANKSKIP (SENT)));
66700 END;
66800
66900 %
67000 READSENT1 ASSEMBLES REMAINDER OF SENTENCE STARTING AT BEGINNING OF NEXT WORD %
67100
67200
67300 EXPR READSENT1 (WORD);
67400
67500 % WORD IS A LIST OF CHARACTERS COMPRISING 1 WORD AS DETERMINED BY SCANWD %
67600
67700 IF TERMIN THEN PROG2 (RESTSENT←NIL, IF TERMIN EQ 'ILL THEN NIL
67800 ELSE
67900 IF NULL WORD THEN NIL
68000 ELSE <READLIST (WORD)>)
68100 ELSE READLIST (WORD) CONS READSENT1 (SCANWD (RESTSENT));
68200
68300 %
68400 RTPAR ELIMINATES LEADING PARENTHETICAL EXPRESSIONS FROM 'S' %
68500
68600
68700 EXPR RTPAR (S, LENG);
68800 BEGIN
68900 NEW N;
69000 FOR N←1 TO LENG DO NIL
69100 UNTIL SUBSTR (S, N, 1) SEQ ")";
69200 RETURN (SUBSTR (S, N+1, 'ALL));
69300 END;
69400
69500 %
69600 SAY HANDLES OUTPUT OF LIST 'STMT' %
69700
69800 EXPR SAY (STMT);
69900 BEGIN
70000 NEW ESTMT;
70100 STMT←STRINGATE (STMT);
70200
70300 % IN "SUPPRESS" OR "TALK" VERSION, ELIMINATE LEADING PARENTHETICAL EXPRESSIONS %
70400
70500 IF (SUPPRESS OR TALK) AND CAR (ESTMT←EXPLODEC STMT) EQ '?( THEN
70600 STMT←RTPAR (STMT, LENGTH ESTMT);
70700 OUT (OWN, PRINTSTR STMT);
70800 IF TALK THEN
70900 BEGIN NEW VALUES; SPECIAL VALUES;
71000 OUT (FILE1, PRINTSTR STMT);
71100 VALUES ← EVAL <'INP, 'DOC,
71200 <'PROG, '(X),
71300 <'PRINTSTR, <'QUOTE, AT STMT>>,
71400 '(PRINT (QUOTE RESPONSE:)),
71500 '(CLEAR_BUFFER),
71600 '(SETQ X (READ)),
71700 '(PRINT (QUOTE PATIENT:)),
71800 '(CLEAR_BUFFER),
71900 '(RETURN (LIST (QUOTE RESPONSE) X (QUOTE PATIENT) (TERPRI (TERPRI (READ)))))>, T>;
72000 OUT(FILE1, PROG2(PRINT VALUES, PRINC TERPRI EOF), NIL, T);
72100 SAVEJOB('HAR000,'SAV); % SAVE THE CORE IMAGE UNDER HAR000.SAV IN CASE THE SYSTEM GOES DOWN. %
72200
72300 % THIS IS THE POINT AT WHICH THE PROGRAM WILL START IF THE SYSTEM GOES DOWN. %
72400 '(FILE1 FILE2) ←⊗ <FILE2, FILE1>;
72500 OUT (FILE1, PRINT_ALL FILE2, T)
72600 END
72610 ELSE IF SAVE_FILE THEN
72620 BEGIN
72630 OUT(FILE1, PRINTSTR STMT);
72640 OUT(FILE1, PRINC TERPRI EOF, NIL, T);
72650 '(FILE1 FILE2) ←⊗ <FILE2, FILE1>;
72660 OUT(FILE1, PRINT_ALL FILE2,T)
72670 END
72700 END;
72800
72900 %
73000 SCANWD RETURNS NEXT WORD IN SENT AS LIST OF CHARACTERS %
73100
73200 EXPR SCANWD (SENT);
73300 BEGIN
73400 NEW CHAR;
73500 RETURN
73600 IF (CHAR←CAR SENT) EQ PERIOD OR CHAR EQ '?? THEN
73700
73800 % ILLEGAL FOR TERMINATOR TO BE FOLLOWED BY OTHER CHARACTERS %
73900
74000 PROG2 (TERMIN←IF NOT BLANKSKIP (CDR SENT) THEN CHAR ELSE 'ILL, NIL)
74100 ELSE
74200 IF CHAR EQ BLANK OR CHAR EQ CR OR CHAR EQ COMMA OR CHAR EQ DASH THEN
74300 PROG2 (RESTSENT←NULLSKIP (SENT), NIL)
74400 ELSE
74500 IF NUMBERP (CHAR) OR GET (CHAR, 'LET) THEN
74600 CHAR CONS SCANWD (CDR SENT)
74700 ELSE PROG2 (TERMIN←'ILL, NIL);
74800 END;
74900
75000 %
75100 SELFREFREPLY INTRODUCES VARIATION INTO CHOSEN "SENSITIVE" REPLY %
75200
75300 EXPR SELFREFREPLY (ADJ, NOUN);
75400 BEGIN
75500 NEW REPLY;
75600 FLAG←NOT (FLAG);
75700 REPLY←CHOOSE ('SENSREPLIES) @
75800 (IF FLAG THEN <ADJ> ELSE <ADJ, NOUN>)
75900 @ '(??);
76000 RETURN (REPLY);
76100 END;
76200
76300 %
76400 SENTYPE SETS UP TYPE OF SENTENCE (STATEMENT, QUESTION, ILLEGAL)
76500 TO RETURN FOR PROCESSING %
76600
76700
76800 EXPR SENTYPE (SENT);
76900 IF TERMIN EQ 'ILL THEN '(: BAD INPUT?; TRY AGAIN?.)
77000 ELSE
77100 IF TERMIN = '?? THEN 'Q CONS SENT ELSE SENT;
77200
77300 %
77400 SPECQUES PROVIDES ANSWERS TO SPECIFIC QUESTIONS RELATED TO THE
77500 DELUSIONAL COMPLEX %
77600
77700 % TO BE REWRITTEN %
77800
77900 EXPR SPECQUES (INP);
78000 BEGIN
78100 NEW WORD, WD, FOUND, QA, PAIR, VALUE;
78200 QA←GET ('ANSWERS, LASTSTMT);
78300 IF QA THEN
78400 FOR PAIR IN QA DO
78500 FOUND←MEMBER1 (CAR (PAIR), INP)
78600 UNTIL FOUND;
78700 IF FOUND THEN
78800
78900 % FOUND KEY WORDS ASSOCIATED WITH LAST DELUSIONAL STATEMENT %
79000
79100 VALUE←BEGIN
79200 LASTSTMT←CADR (PAIR);
79300 RETURN (CHOOSEDEL (CADR (PAIR)));
79400 END;
79500 IF NOT VALUE THEN
79600
79700 % AT ANY POINT IN DELUSION DISCUSSION, IF 'WHO' IS NOT OTHERWISE RECOGNIZED,
79800 ASSUME AS REFERRING TO MAFIA %
79900
80000 IF ((WD←INP[2]) EQ 'WHO) OR (WD EQ 'WHOM) THEN VALUE←'(THE MAFIA);
80100 IF NOT FOUND THEN
80200 IF ('THEY MEMBER INP) AND (('DO MEMBER INP) OR ('ARE MEMBER INP)) AND (LENGTH (INP) LESSP 4)
80300 AND (CAR (INP) EQ 'Q) THEN
80400 VALUE←'(THAT?'S RIGHT);
80500 IF VALUE THEN
80600 BEGIN
80700
80800 % DELETE ANY NEW DELUSIONAL WORDS IN 'SELF'S STATEMENT
80900 FROM DELUSION LIST %
81000
81100 DELCHECK (VALUE);
81200 SAY (VALUE);
81300 END;
81400 RETURN (VALUE);
81500 END;
81600
81700 %
81800 SPECREAX PROVIDES THE APPROPRIATE REACTION OF 'SELF TO SPECIAL TYPES
81900 OF STATEMENT OF 'OTHER %
82000
82100 EXPR SPECREAX (STMT);
82200
82300 IF CAR STMT EQ 'S THEN
82400 PROG2 (SAY (CHOOSE ('SILENCE)), T)
82500 ELSE
82600 IF 'YOU MEMBER STMT AND MEMBER1 (GET ('ABNORMAL, 'IND), STMT) THEN
82700
82800 % INSINUATION THAT 'SELF IS MENTALLY ILL %
82900
83000 BEGIN
83100 IF CAR STMT EQ 'Q THEN FJUMP←(AJUMP←0.3)
83200 ELSE FJUMP←(AJUMP←0.5);
83300 SAY (CHOOSE ('ALIEN));
83400 RETURN T;
83500 END;
83600
83700 %
83800 SPLIT MAKES LIST OUT OF HYPHENATED WORDS OF AN ATOM %
83900
84000 EXPR SPLIT (JOIND);
84100 BEGIN
84200 NEW LET, WD, LST;
84300 FOR LET IN REVERSE (EXPLODEC (JOIND)) DO
84400 IF LET = DASH THEN PROG2 (LST←READLIST (WD) CONS LST, WD←NIL)
84500 ELSE WD←LET CONS WD;
84600 RETURN (READLIST (WD) CONS LST);
84700 END;
84800
84900 %
85000 STRINGATE MAKES A STRING OUT OF A QUOTED LIST %
85100
85200 EXPR STRINGATE (L);
85300 FOR NEW WD IN L; CAT WD CAT " ";
85400
85500 %
85600 THREAT %
85700
85800 EXPR THREAT (STMT);
85900 BEGIN
86000 NEW FOUND;
86100 IF FOUND←MEMBER1 (GET ('DELWDS, 'NOUNS) @ GET ('DELWDS, 'VERBS), STMT) THEN
86200 IF MEMBER1 (NLIST, STMT) THEN
86300 BEGIN
86400 FEAR←FEAR-1;
86500 FOUND←CHOOSE ('CAUTION);
86600 END
86700 ELSE
86800 IF 'I MEMBER STMT THEN
86900 BEGIN
87000 FJUMP←0.5;
87100 FOUND←CHOOSE ('PANIC);
87200 END
87300 ELSE FOUND←NIL;
87400 IF FOUND THEN RETURN (PROG2 (SAY (FOUND), T))
87500 ELSE RETURN (NIL);
87600 END;
87700
87800 %
87900 YES SCANS STATEMENT OF 'OTHER FOR AFFIRMATIVE EXPRESSIONS %
88000
88100 % TO BE REWRITTEN %
88200
88300 EXPR YES (INP);
88400 IF GET ('BELIEVEREPLIES, 'IND) THEN
88500
88600 % POSITIVE ANSWER TO QUESTION IS AFFIRMATIVE--
88610 APPLIES TO ALL 'BELIEVEREPLIES USED EXCEPT LAST ONE ON LIST %
88700
88800 (NOT MEMBER1 (GET ('DISBELIEF, 'IND), INP)) AND NOT ('NO MEMBER INP) AND
88900 (('YES MEMBER INP) OR ('CERTAINLY MEMBER INP) OR
89000 ('GUESS MEMBER INP) OR ('SURE MEMBER INP))
89100 ELSE
89200
89300 % NEGATIVE ANSWER TO NEGATIVE STATEMENT IS AFFIRMATIVE %
89400
89500 (NOT MEMBER1 (GET ('DISBELIEF, 'IND), INP)) AND ('NO MEMBER INP)
89600 ;
89700
89800
89900
90000 % ***** MAIN PROGRAM ***** %
90100
90200
90300 INITIALIZE();
90400
90500 PRINTSTR "
90600 END INPUT WITH A PERIOD OR QUESTION MARK, FOLLOWED BY TWO ALTMODES.
90700 SPELL OUT NUMBERS.
90800 TO INDICATE SILENCE, TYPE 'S.'
90900 WHEN FINISHED, TYPE 'BYE.'
91000 ";
91100
91200
91300 WHILE NOT ENDE DO
91400 BEGIN NEW OK;
91500 INTERPERS←NIL; % REINITIALIZE INTERPERSONAL ATTITUDE %
91600 IF TALK THEN
91700 BEGIN
91800 IF ¬JOB_EXISTS('DOCJOB) THEN
91900 BEGIN
92000 PRINTSTR "THE DOCTOR HAS NOT STARTED RUNNING 'DOCJOB' YET.";
92100 DO SLEEP(30) UNTIL JOB_EXISTS('DOCJOB) | PROG2(PRINTSTR "STILL HASN'T STARTED 'DOCJOB'", NIL);
92200 TERPRI PRINTSTR "OK, HE JUST STARTED IT.";
92300 SLEEP(30) % MAKE SURE HE HAS TIME TO START IT UP. %
92400 END;
92500 MESSAGE ← EXPLODEC INP(DOC, READ_MESSAGE(), NIL);
92600 OUT (OWN, PRINT_MESSAGE (MESSAGE));
92700 OK ← INP(OWN, TERPRI READ()); % T OR NIL %
92800 END;
92900 IF ¬OK THEN MESSAGE ← INP(OWN, READ_MESSAGE());
93000 WHILE BADINP (REMARK←SENTYPE (READSENT (MESSAGE))) DO MESSAGE ← INP(OWN, READ_MESSAGE()) ;
93100 IF TALK | SAVE_FILE THEN OUT (FILE1, PRINT_MESSAGE (TERPRI TERPRI MESSAGE));
93200 IF 'BYE MEMBER REMARK OR FEAR GREATERP 18.4 THEN ENDE ← T
93300 ELSE
93400 BEGIN
93500 SPECREAX (REMARK) OR DELREF (REMARK) OR SELFREF (REMARK) OR FLAREREF (REMARK)
93600 OR PERSREL (REMARK) OR NORMAL (REMARK);
93700 MODIFVAR ();
93800 END;
93900 END;
94000 SAY (IF (DELFLAG OR (FLARE NEQ 'INIT)) AND NOT (FEAR GREATERP 18.4) THEN
94100 PROG2 (AJUMP←0.1, '((OFFENDED) GOOD BYE))
94200 ELSE '(BYE));
94300 TRACEV←T;
94400 MODIFVAR ();
94500 END.